home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / comm / thor / dmthor.lha / DMThor.thor < prev   
Text File  |  1997-04-25  |  8KB  |  338 lines
  1. /*
  2. **   Filename: DMThor.thor
  3. **
  4. **   $VER: v1.52 (25APR97)
  5. **
  6. **   Author:  Troy E. Bouchard
  7. **
  8. **   Address: 811 Thorsheim
  9. **          Kodiak, AK 99615
  10. **            USA
  11. **
  12. **   EMail:   tbouchar@ptialaska.net
  13. **   Webpage: http://www.ptialaska.net/~tbouchar
  14. **
  15. **
  16. **   Requires:    Thor v2.1+ - Although this script was written with
  17. **        Thor v2.4  - it should work with versions 2.1 and up
  18. **        (not tested though)
  19. **
  20. */
  21.  
  22. options results
  23.  
  24. /* Find our Thor Port and number! */
  25. p = Address() || ' ' || show('P',,)
  26.     ThorPort = pos('THOR.',p)
  27.  
  28.     if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  29. else
  30.     do
  31.     say "Can't seem to find the Thor port!"
  32.     exit 10
  33.     End
  34.  
  35. /* Load the BBSRead library up! */
  36. if ~show('p', 'BBSREAD') then
  37. do
  38.     address command
  39.         "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  40.         "WaitForPort BBSREAD"
  41. End
  42.  
  43. SIGNAL ON SYNTAX
  44. SIGNAL ON HALT
  45.  
  46. MDF_DELETED = 5       /* Message is deleted      */
  47. MDF_UNRECOVERABLE = 6 /* Message is unrecoverable */
  48.  
  49. TB_MSGPATH = 'T:'
  50. TB_MYDATE = Translate(Date(),," ","_")
  51.  
  52. Call GetPages
  53. Call Done
  54.  
  55. GetPages:
  56.    Address BBSREAD
  57.    'GETBBSLIST stem "'BBSLIST'"'
  58.    if(rc ~=0) then
  59.    do
  60.       Address(ThorPort)
  61.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  62.       call cleanup
  63.    End
  64.  
  65.    Address(ThorPort)
  66.    'REQUESTLIST instem "'BBSLIST'" outstem "'TB_SYSTEM'" title "Selection:" DRAGSELECT MULTISELECT SIZEGADGET'
  67.    if(rc ~= 0) then exit
  68.    do i=1 to TB_SYSTEM.COUNT
  69.       Address BBSREAD
  70.       'GETCONFLIST "'TB_SYSTEM.i'" CONFLIST'
  71.       if(rc ~= 0) then
  72.       do
  73.      Address(ThorPort)
  74.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  75.      call cleanup
  76.       End
  77.  
  78.       Address(ThorPort)
  79.       'REQUESTLIST instem "'CONFLIST'" title "Select conference on ' || TB_SYSTEM.i || ":" ||'" SIZEGADGET'
  80.       if(rc ~= 0) then TB_CONFNAME = ""
  81.       else TB_CONFNAME = result
  82.  
  83.       MyConf = Translate(TB_CONFNAME,," ","_")
  84.  
  85.       Address BBSREAD
  86.       'GETCONFDATA BBSName "'TB_SYSTEM.i'" ConfName "'TB_CONFNAME'" Stem CDATA'
  87.       if(rc ~= 0) then
  88.       do
  89.      Address(ThorPort)
  90.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  91.      call cleanup
  92.       End
  93.  
  94.      Call MessageHeader
  95.      Call TopicText
  96.  
  97.       Address(ThorPort)
  98.       'OPENPROGRESS TITLE " DMThor v1.52" PT "Getting Messages..." AT "_Abort" PCW 30'
  99.       if(rc ~= 0) then
  100.       do
  101.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  102.      call cleanup
  103.       end
  104.       else win = result
  105.  
  106.       msgnumber = 0
  107.  
  108.       do j = CDATA.FIRSTMSG to CDATA.LASTMSG
  109.      Drop MsgData.
  110.      Drop HeaderInfo.
  111.      Drop TextInfo.
  112.  
  113.      Address BBSREAD
  114.      'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" DataStem "'MsgData'"'
  115.      if(rc ~= 0) then
  116.      do
  117.         Address(ThorPort)
  118.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  119.         call cleanup
  120.      end
  121.  
  122.      if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  123.      do
  124.         msgnumber = msgnumber + 1
  125.         Address(ThorPort)
  126.         msgtext = 'Saving Messages to: 'MyConf||'.'||TB_MYDATE
  127.         'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnumber'" PT "'msgtext'"'
  128.         if(rc ~= 0) then do
  129.           call cleanup
  130.         end
  131.  
  132.         Address BBSREAD
  133.         'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" TextStem "'TextInfo'" HeadStem "'HeaderInfo'"'
  134.         if(rc ~= 0) then
  135.         do
  136.            Address(ThorPort)
  137.            'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  138.            call Cleanup
  139.         end
  140.  
  141.         'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  142.         if(rc ~= 0) then
  143.         do
  144.         NewTime = value('HeaderInfo.CREATIONDATETXT')
  145.         Say ''
  146.         Say 'OH NO!  CREATIONDATE IS SET TO TEXT!'
  147.         Say NewTime
  148.         Say 'Delete Message nr: 'j' and try again'
  149.         call Cleanup
  150.         end
  151.  
  152.         if symbol('HeaderInfo.FROMADDR') = "VAR" then
  153.            Addr = value('HeaderInfo.FROMADDR')
  154.  
  155.         if symbol('HeaderInfo.FROMNAME') = "VAR" then
  156.            Nom = value('HeaderInfo.FROMNAME')
  157.  
  158.         if symbol('HeaderInfo.SUBJECT') = "VAR" then
  159.            Subj = value('HeaderInfo.SUBJECT')
  160.  
  161.         if symbol('HeaderInfo.TOADDR') = "VAR" then
  162.         ToAdd = value('HeaderInfo.TOADDR')
  163.  
  164.         Call MessageText
  165.      end
  166.       end
  167.    end
  168. Return
  169.  
  170. Done:
  171.    Address(ThorPort)
  172.    'REQUESTNOTIFY TEXT "    We Are Done!\nDigest Files Copied!" BT "_Cool!"'
  173.    'CLOSEPROGRESS REQ' win
  174.    Call DelMSGS
  175.  
  176. MessageHeader:
  177.    Call Open out, TB_MSGPATH || MyConf || '.'||TB_MYDATE, w
  178.    Call WriteLN out, '                    '|| MyConf || ' Digest for '||Date()
  179.    Call WriteLN out, ' '
  180.    Call WriteLN out, 'Topics for Conference 'MyConf||':'
  181.    Call WriteLN out, ' '
  182.    Call Close out
  183. Return
  184.  
  185. TopicText:
  186.    Address(ThorPort)
  187.    'OPENPROGRESS TITLE " DMThor v1.52" PT "Getting Topics..." AT "_Abort" PCW 30'
  188.    if(rc ~= 0) then
  189.    do
  190.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  191.       call cleanup
  192.    end
  193.    else win = result
  194.  
  195.    msgnbr = 0
  196.  
  197.    do k = CDATA.FIRSTMSG to CDATA.LASTMSG
  198.       Drop HeaderInfo.
  199.       Drop MsgData.
  200.  
  201.       Address BBSREAD
  202.       'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'k'" DataStem "'MsgData'"'
  203.       if(rc ~= 0) then
  204.       do
  205.      Address(ThorPort)
  206.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  207.      call cleanup
  208.       end
  209.  
  210.       if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  211.       do
  212.      msgnbr = msgnbr + 1
  213.      Address(ThorPort)
  214.      msgtext = 'Saving Topics to: 'MyConf||'.'TB_MYDATE
  215.      'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnbr'" PT "'msgtext'"'
  216.      if(rc ~= 0) then do
  217.         call cleanup
  218.      end
  219.  
  220.      Address BBSREAD
  221.      'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'k'" HeadStem "'HeaderInfo'"'
  222.      if(rc ~= 0) then
  223.      do
  224.         Address(ThorPort)
  225.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  226.         call Cleanup
  227.      end
  228.  
  229.      'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  230.      if(rc ~= 0) then
  231.      do
  232.         NewTime = value('HeaderInfo.CREATIONDATETXT')
  233.         Say ''
  234.         Say 'OH NO!  CREATIONDATE IS SET TO TEXT!'
  235.         Say 'I can not resolve something like this yet!'
  236.         Say 'Delete Message nr: 'k' and try again'
  237.         call Cleanup
  238.      end
  239.  
  240.      if symbol('HeaderInfo.FROMADDR') = "VAR" then
  241.         Addr = value('HeaderInfo.FROMADDR')
  242.  
  243.      if symbol('HeaderInfo.FROMNAME') = "VAR" then
  244.         Nom = value('HeaderInfo.FROMNAME')
  245.  
  246.      if symbol('HeaderInfo.SUBJECT') = "VAR" then
  247.         Subj = value('HeaderInfo.SUBJECT')
  248.  
  249.      Call Open out, TB_MSGPATH || MyConf || '.'||TB_MYDATE, a
  250.      Call WriteLN out, msgnbr'.  'Subj
  251.      Call WriteLN out, '          by 'Nom' ('Addr')'
  252.      Call WriteLN out, ' '
  253.      Call Close out
  254.       end
  255.    end
  256.  
  257.    if (win ~= 0) & Symbol('win') = 'VAR' then do
  258.       Address(ThorPort)
  259.       'CloseProgress REQ' win
  260.    end
  261. Return
  262.  
  263. MessageText:
  264.    Call Open out, TB_MSGPATH || MyConf || '.'||TB_MYDATE,a
  265.    Call WriteLN out, '-------------------------------------'
  266.  
  267.    Call WriteLN out, 'From: 'Nom' ('Addr')'
  268.    Call WriteLN out, 'To: 'ToAdd
  269.    Call WriteLN out, 'Subject: 'Subj
  270.    Call WriteLN out, ' '
  271.  
  272.    cnt = value('TextInfo.TEXT.COUNT')
  273.  
  274.    if(cnt = 0) then call writeln(out,'No Text')
  275.       else
  276.       do
  277.      do n = 1 to cnt
  278.         call writeln(out, value('TextInfo.TEXT.n'))
  279.      end
  280.      Call Close out
  281.       end
  282.       Call Close out
  283. Return
  284.  
  285. DelMSGS:
  286.    if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  287.    do
  288.       Address(ThorPort)
  289.       'REQUESTNOTIFY TEXT "Delete Messages in\nConference 'MyConf'?" BT "_NO|_OK"'
  290.       if(rc ~= 0) then
  291.       do
  292.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  293.      Call Cleanup
  294.       End
  295.  
  296.       if(result = 0) then Call DelProgress
  297.       if(result = 1) then Call Cleanup
  298.    End
  299.  
  300.    'REQUESTNOTIFY TEXT "No messages to Delete!" BT "_OK"'
  301.  
  302. DelProgress:
  303.    'CURRENTSYSTEM stem "'TB_SYS'"'
  304.  
  305.    'OPENPROGRESS TITLE "Deleting messages" PT "Getting messages..." AT "_Abort" PCW 30'
  306.    if(rc = 0) then
  307.    do
  308.      win = result
  309.      do d=CDATA.FIRSTMSG to CDATA.LASTMSG
  310.     Address(ThorPort)
  311.     'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'d-CDATA.FIRSTMSG+1'" PT "Deleting message # 'd'" '
  312.     if(rc ~= 0) then
  313.     do
  314.        'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  315.        Call Cleanup
  316.     end
  317.  
  318.     Address BBSRead
  319.     'UPDATEBRMESSAGE "'TB_SYS.BBSNAME'" "'MyConf'" "'d'" SETDELETED'
  320.     if(rc ~= 0) then
  321.     do
  322.        'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  323.        Call Cleanup
  324.     end
  325.      end
  326.    end
  327. Call Cleanup
  328.  
  329. SYNTAX:
  330.   SAY 'Error: 'rc' in line 'sigl': 'errortext(rc)
  331. HALT:
  332. cleanup:
  333.  IF (win ~= 0) & SYMBOL('win') = 'VAR' THEN DO
  334.    ADDRESS(ThorPort)
  335.    'CLOSEPROGRESS REQ' win
  336.  END
  337. EXIT
  338.